Drag and drop kde je chyba
Otázka od: Vymazal Milan
21. 10. 2002 8:52
Zdravim
pomoci teto zapisu do edit6 presunuty soubor na formular.
jenze mi to nejak nefunguje a nevim vubec proc. ve starem programu mi
to fungovalo ale tady ne proc ?
PROCEDURE TAddNewRecord.FileIsDropped ( VAR Msg : TMessage ) ;
var
hDropData: HDROP;
i, iCount, iLength: Integer;
pFile: PChar;
s:string;
begin
with Msg do
begin
if Msg = WM_DROPFILES then
begin
hDropData := THandle(wParam);
iCount := DragQueryFile(hDropData, $FFFFFFFF, nil, 0);
for i := 0 to iCount - 1 do
begin
iLength := DragQueryFile(hDropData, i, nil, 0);
pFile := StrAlloc(iLength + 1);
DragQueryFile(hDropData, i, pFile, iLength + 1);
s:=StrPas(pfile);
edit6.text:=copy(s,14,length(s));
StrDispose(pFile);
end;
DragFinish(hDropData);
Result := 0;
end
end;
END ;
+ tohle
procedure TAddNewRecord.FormCreate(Sender: TObject);
begin
DragAcceptFiles( Handle,True ) ;
end;
end.
Odpovedá: Ondrej Kelle
21. 10. 2002 10:48
Ahoj,
> pomoci teto zapisu do edit6 presunuty soubor na formular.
> jenze mi to nejak nefunguje a nevim vubec proc. ve starem programu mi
> to fungovalo ale tady ne proc ?
>
>
>
> PROCEDURE TAddNewRecord.FileIsDropped ( VAR Msg : TMessage ) ;
> var
> hDropData: HDROP;
> i, iCount, iLength: Integer;
> pFile: PChar;
> s:string;
> begin
> with Msg do
> begin
> if Msg = WM_DROPFILES then
> begin
> hDropData := THandle(wParam);
> iCount := DragQueryFile(hDropData, $FFFFFFFF, nil, 0);
> for i := 0 to iCount - 1 do
> begin
> iLength := DragQueryFile(hDropData, i, nil, 0);
> pFile := StrAlloc(iLength + 1);
> DragQueryFile(hDropData, i, pFile, iLength + 1);
> s:=StrPas(pfile);
> edit6.text:=copy(s,14,length(s));
> StrDispose(pFile);
> end;
> DragFinish(hDropData);
> Result := 0;
> end
> end;
>
> END ;
>
> + tohle
> procedure TAddNewRecord.FormCreate(Sender: TObject);
> begin
> DragAcceptFiles( Handle,True ) ;
>
> end;
>
> end.
Ten kod vyzera byt v poriadku, ale procedura FileIsDropped musi byt
odniekial volana. Mas ju v deklaracii triedy oznacenu direktivou message
WM_DROPFILES?
Okrem toho, ak je tych suborov viac, edit6.text sa prepisuje kazdym z nich a
nakoniec tam zostane meno toho posledneho suboru. Nepises, co konkretne
nefunguje.
Tu je (velmi podobny) kod, ktory pouzivam ja, neprisiel som na ziadne
problemy s nim a obsahuje kompletne vsetko, co potrebujes na spracovanie
WM_DROPFILES:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
procedure WMDropFiles(var Message: TWMDropFiles); message WM_DROPFILES;
end;
implementation
uses
ShellApi;
procedure TForm1.WMDropFiles(var Message: TWMDropFiles);
var
FileCount, I: Integer;
FileName: PChar;
FileNameSize: Integer;
begin
try
FileCount := DragQueryFile(Message.Drop, Cardinal(-1), nil, 0);
for I := 0 to FileCount - 1 do
begin
FileNameSize := DragQueryFile(Message.Drop, I, nil, 0);
FileName := AllocMem(FileNameSize + 1);
try
DragQueryFile(Message.Drop, I, FileName, FileNameSize + 1);
OutputDebugString(FileName);
finally
FreeMem(FileName);
end;
end;
finally
DragFinish(Message.Drop);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles(Handle, True);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DragAcceptFiles(Handle, False);
end;
Okrem toho mam este napisanu jednu starodavnu komponentu TDropFiles, ktora
ma property Control: TWinControl, ktoru registruje pomocou DragAcceptFiles a
za behu subclassne a potom pri WM_DROPFILES spusti OnDropFiles event.
Vyhodou je, ze si takto mozes registrovat lubovolnu TWinControl (TMemo
apod.) na formulari bez toho, aby si pisal novu triedu kvoli spracovaniu tej
spravy. Ak ma niekto zaujem, mozem ten kod oprasit a poslat sem.
HTH
TOndrej
Odpovedá: Vymazal Milan
21. 10. 2002 12:26
Cau
no chybelo mi tam to message WM_DROPFILES;. Nevsiml jsem si toho.
Diky moc
Milan
OK> Ahoj,
>> pomoci teto zapisu do edit6 presunuty soubor na formular.
>> jenze mi to nejak nefunguje a nevim vubec proc. ve starem programu mi
>> to fungovalo ale tady ne proc ?
>>
>>
>>
>> PROCEDURE TAddNewRecord.FileIsDropped ( VAR Msg : TMessage ) ;
>> var
>> hDropData: HDROP;
>> i, iCount, iLength: Integer;
>> pFile: PChar;
>> s:string;
>> begin
>> with Msg do
>> begin
>> if Msg = WM_DROPFILES then
>> begin
>> hDropData := THandle(wParam);
>> iCount := DragQueryFile(hDropData, $FFFFFFFF, nil, 0);
>> for i := 0 to iCount - 1 do
>> begin
>> iLength := DragQueryFile(hDropData, i, nil, 0);
>> pFile := StrAlloc(iLength + 1);
>> DragQueryFile(hDropData, i, pFile, iLength + 1);
>> s:=StrPas(pfile);
>> edit6.text:=copy(s,14,length(s));
>> StrDispose(pFile);
>> end;
>> DragFinish(hDropData);
>> Result := 0;
>> end
>> end;
>>
>> END ;
>>
>> + tohle
>> procedure TAddNewRecord.FormCreate(Sender: TObject);
>> begin
>> DragAcceptFiles( Handle,True ) ;
>>
>> end;
>>
>> end.
OK> Ten kod vyzera byt v poriadku, ale procedura FileIsDropped musi byt
OK> odniekial volana. Mas ju v deklaracii triedy oznacenu direktivou message
OK> WM_DROPFILES?
OK> Okrem toho, ak je tych suborov viac, edit6.text sa prepisuje kazdym z nich
a
OK> nakoniec tam zostane meno toho posledneho suboru. Nepises, co konkretne
OK> nefunguje.
OK> Tu je (velmi podobny) kod, ktory pouzivam ja, neprisiel som na ziadne
OK> problemy s nim a obsahuje kompletne vsetko, co potrebujes na spracovanie
OK> WM_DROPFILES:
OK> type
OK> TForm1 = class(TForm)
OK> procedure FormCreate(Sender: TObject);
OK> procedure FormDestroy(Sender: TObject);
OK> private
OK> procedure WMDropFiles(var Message: TWMDropFiles); message WM_DROPFILES;
OK> end;
OK> implementation
OK> uses
OK> ShellApi;
OK> procedure TForm1.WMDropFiles(var Message: TWMDropFiles);
OK> var
OK> FileCount, I: Integer;
OK> FileName: PChar;
OK> FileNameSize: Integer;
OK> begin
OK> try
OK> FileCount := DragQueryFile(Message.Drop, Cardinal(-1), nil, 0);
OK> for I := 0 to FileCount - 1 do
OK> begin
OK> FileNameSize := DragQueryFile(Message.Drop, I, nil, 0);
OK> FileName := AllocMem(FileNameSize + 1);
OK> try
OK> DragQueryFile(Message.Drop, I, FileName, FileNameSize + 1);
OK> OutputDebugString(FileName);
OK> finally
OK> FreeMem(FileName);
OK> end;
OK> end;
OK> finally
OK> DragFinish(Message.Drop);
OK> end;
OK> end;
OK> procedure TForm1.FormCreate(Sender: TObject);
OK> begin
OK> DragAcceptFiles(Handle, True);
OK> end;
OK> procedure TForm1.FormDestroy(Sender: TObject);
OK> begin
OK> DragAcceptFiles(Handle, False);
OK> end;
OK> Okrem toho mam este napisanu jednu starodavnu komponentu TDropFiles, ktora
OK> ma property Control: TWinControl, ktoru registruje pomocou DragAcceptFiles
a
OK> za behu subclassne a potom pri WM_DROPFILES spusti OnDropFiles event.
OK> Vyhodou je, ze si takto mozes registrovat lubovolnu TWinControl (TMemo
OK> apod.) na formulari bez toho, aby si pisal novu triedu kvoli spracovaniu
tej
OK> spravy. Ak ma niekto zaujem, mozem ten kod oprasit a poslat sem.
OK> HTH
OK> TOndrej
--
Best regards,
Vymazal mailto:vymazal.milan@seznam.cz